home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 2.2 / screendump.st < prev    next >
Text File  |  1993-07-24  |  9KB  |  278 lines
  1. "    NAME        screendump
  2.     AUTHOR        miw@cs.man.ac.uk
  3.     FUNCTION chunks of screen -> Postscript 
  4.     ST-VERSIONS    2.2
  5.     PREREQUISITES     
  6.     CONFLICTS    
  7.     DISTRIBUTION      world
  8.     VERSION        1.1
  9.     DATE    22 Jan 1989
  10. SUMMARY    screendump
  11.     enable one to write forms an arbitrary bits of screen
  12.    out to a file in PostScript format.  
  13.    ctl-shift-d.st may also be useful .(2.2).MIW
  14.  
  15. --------------------
  16. Comments from Andrew Jones <andrew@computing-maths.cardiff.ac.uk> about using this goodie with the Tek 4404:
  17.  
  18. Because Tek 4404 Smalltalk SmallIntegers lie in the range [-16384, 16383]
  19. they cannot represent some word values properly: LargePositive and Negative
  20. Integers are needed. There is a method which was originally defined
  21. for SmallInteger which I thus had to redefine for Integer. (something
  22. which printed out a Hex version of a number).
  23.  
  24. Some pictures came out strangely, with one or two small blank areas.
  25. I suspected that Tektronix Integers might not like the message:
  26.  
  27.     bitXor: -1
  28.  
  29. I changed it to:
  30.  
  31.     bitXor: 65535
  32.  
  33. and the problem went away. But don't ask me why!!
  34.  
  35. "!
  36. "This package enables one to write Forms out in PostScript format.  Two mechanisms are provided: 
  37. 1. Ability to write out a Form using 
  38.         aForm psWriteFileOn: 'aFileName'
  39.         aForm psWriteFileOn: 'aFileName' scaleFactor: aNumber
  40.         aForm psWriteFileOn: 'aFileName' scaleFactor: aNumber origin: aPoint
  41.  
  42. 2. Ability to dump a section of the display screen interactively.  Run
  43.         Form doScreenDump
  44. You will be asked to designate an area of the screen, then whether you want the cursor to appear in the screen dump, and what file name to write to.
  45. Then a page-sized area of the screen will be reversed, and you will be asked to designate the area of the page on which you want the form to appear.  The aspect ratio of the original form will be preserved.
  46.  
  47. The file produced should be ready to print on a PostScript device.
  48.  
  49. If you also file in the appropriate 'ctl-shift-d.st' file (there is one for pre-2.2 images, and one for 2.2 and after)  'Form doScreenDump' can be invoked by hitting ctl-sh-d."
  50.  
  51. 'From Smalltalk-80, version 2, of April 1, 1983 on 23 January 1987 at 6:49:57 pm'!
  52.  
  53. !Point methodsFor: 'arithmetic'!
  54.  
  55. negated
  56.     ^x negated @ y negated! !
  57.  
  58. !Point methodsFor: 'converting'!
  59.  
  60. convertFromPostScriptToScreenPixels
  61.     | scale |
  62.     scale _ DisplayScreen pixelsPerInch / Form postScriptPixelsPerInch.
  63.     ^(self translateBy: (0@Form postScriptPageSize y negated)) scaleBy: (scale @ scale negated)! 
  64.  
  65. convertFromScreenToPostScriptPixels
  66.     | scale |
  67.     scale _ Form postScriptPixelsPerInch / DisplayScreen pixelsPerInch.
  68.     ^(self scaleBy: (scale @ scale negated)) translateBy: (0@Form postScriptPageSize y)! !
  69.  
  70.  
  71. !Character class methodsFor: 'accessing untypeable characters'!
  72.  
  73. lf
  74.     "Answer the Character representing a line feed."
  75.  
  76.     ^self value: 10! !
  77.  
  78. !Form methodsFor: 'fileIn/Out'!
  79.  
  80. dumpHexBytesOn: aFile invert: invert
  81.     "write out the bitmap data to the file in hex, rounding up to byte boundaries,
  82.      and complementing the bits if necessary"
  83.     | count bytesPerLine word byte |
  84.     count _ 0.
  85.     bytesPerLine _ width + 7 // 8.
  86.     height timesRepeat:
  87.         [(bytesPerLine // 2) timesRepeat:
  88.              [word _ bits at: (count _ count + 1).
  89.               invert ifTrue: [word _ word bitXor: -1].
  90.               aFile nextPutAll: word printHexWord].
  91.          bytesPerLine even    "do the last byte"
  92.             ifFalse: [byte _ (bits at: (count _ count + 1)) bitShift: -8.
  93.                      invert ifTrue: [byte _ byte bitXor: -1].
  94.                     aFile nextPutAll: byte printHexByte].
  95.         aFile lf.
  96.         Processor yield].! !
  97.  
  98. !SmallInteger methodsFor: 'printing'!
  99.  
  100. printHexByte
  101.     "print the receiver as two hex chars"
  102.  
  103.     | s |
  104.     s _ String new: 2.
  105.     s at: 1 put: (Character digitValue: ((self bitAnd: 16rF0) bitShift: -4)).
  106.     s at: 2 put: (Character digitValue: (self bitAnd: 16r0F)).
  107.     ^s!
  108.  
  109. printHexWord
  110.     "print the receiver as four hex chars"
  111.  
  112.     | s |
  113.     s _ String new: 4.
  114.     s at: 1 put: (Character digitValue: ((self bitAnd: 16rF000) bitShift: -12)).
  115.     s at: 2 put: (Character digitValue: ((self bitAnd: 16r0F00) bitShift: -8)).
  116.     s at: 3 put: (Character digitValue: ((self bitAnd: 16r00F0) bitShift: -4)).
  117.     s at: 4 put: (Character digitValue: (self bitAnd: 16r000F)).
  118.     ^s! !
  119.  
  120. !WriteStream methodsFor: 'character writing'!
  121.  
  122. lf
  123.     "Append a linefeed character to the receiver."
  124.  
  125.     self nextPut: Character lf! !
  126.  
  127.  
  128. !DisplayScreen class methodsFor: 'current display'!
  129.  
  130. pixelsPerInch
  131.     "Enter a constant suitable for your hardware"
  132.     ^75! !
  133.  
  134. !Form methodsFor: 'conversion to/from PostScript'!
  135.  
  136.  
  137.  
  138. psWriteFileOn: fileName
  139.     "Saves the receiver on the file fileName in PostScript format"
  140.     self psWriteFileOn: fileName scaleFactor: 1 origin: 0@0        "seems a reasonable default"!
  141.  
  142.  
  143.  
  144. psWriteFileOn: fileName scaleFactor: scale
  145.     "Saves the receiver on the file fileName in PostScript format"
  146.     self psWriteFileOn: fileName scaleFactor: scale origin: 0@0!
  147.  
  148. psWriteFileOn: fileName scaleFactor: scaleFactor origin: origin
  149.     "Saves the receiver on the file fileName in PostScript format,
  150.      mapping one Smalltalk bitmap pixel onto a 'scaleFactor'-shaped PostScript pixel.
  151.      The image is placed at the 'origin' point in the PostScript coordinate system.
  152.  
  153.     Thus a 100x50 Form with scaleFactor 2@3, origin 100@150 gives the file:
  154.         %!!...
  155.  
  156.         /picstr 13 string def
  157.         100 150 translate
  158.         200 150 scale
  159.         100 50 1 [100 0 0 -50 0 50] {currentfile picstr readhexstring pop} image
  160.         ...50 rows of 26 data bytes (in hex)...
  161.         showpage
  162.     "
  163.     | file |
  164.     file _ FileStream fileNamed: fileName.
  165.     file text.
  166.     file nextPutAll: '%!!PS-Adobe-1.0' ; lf.
  167.     file nextPutAll: '%%Creator: Smalltalk-80' ; lf.
  168.     file nextPutAll: '%%CreationDate: ', Date dateAndTimeNow printString ; lf.
  169.     file nextPutAll: '%%Pages: 1' ; lf.
  170.     file nextPutAll: '%%BoundingBox: ',
  171.             origin x asInteger printString, ' ',
  172.             origin y asInteger printString, ' ',
  173.             (origin x asInteger + (width*scaleFactor asPoint x) asInteger) printString, ' ',
  174.             (origin y asInteger + (height*scaleFactor asPoint y) asInteger) printString ; lf.
  175.  
  176.     "set up a PostScript string variable to read a scan line"
  177.     file nextPutAll: '/picstr ', (width + 7 // 8) printString, ' string def' ; lf.
  178.     file nextPutAll: '%%EndProlog' ; lf.
  179.     file nextPutAll: '%%Page: 1 1' ; lf.
  180.  
  181.     "write the PostScript prologue for this image on the stream.
  182.      The transformation matrix is chosen so that the reference point of the
  183.      image is at bottom left."
  184.     "There are two sensible choices for the transformation matrix:
  185.             [width 0 0 height 0 0] (for inclusion in TeX files),
  186.     and        [width 0 0 -height 0 height] (for straight output to a PostScript device).
  187.     This method uses the latter."
  188.  
  189.     file nextPutAll: (origin x asInteger printString, ' ',
  190.                     origin y asInteger printString, ' translate') ; lf.
  191.  
  192.     file nextPutAll: ((width*scaleFactor asPoint x) asInteger printString, ' ',
  193.                     (height*scaleFactor asPoint y) asInteger printString, ' scale') ; lf.
  194.  
  195.     file nextPutAll: (width printString, ' ' , height printString, ' 1 [',
  196.                             width printString, ' 0 0 ', 
  197.                             height negated printString, ' 0 ', height printString).
  198.     file nextPutAll: '] {currentfile picstr readhexstring pop} image' ; lf.
  199.  
  200.     "now dump the image data"
  201.     self dumpHexBytesOn: file invert: true.
  202.  
  203.     "and end the thing off"
  204.     file nextPutAll: 'showpage' ; lf.
  205.     file nextPutAll: '%%Trailer' ; lf.
  206.     file close!
  207.  
  208. reversePageSizedAreaAt: aPoint
  209.     self reverse: 
  210.         (Rectangle origin: aPoint extent: 
  211.             (Form postScriptPageSize * DisplayScreen pixelsPerInch / Form postScriptPixelsPerInch))! !
  212.  
  213. !Form class methodsFor: 'screen dumping'!
  214.  
  215. doScreenDump
  216.     | currentCursor currentPoint rect area filename position scale origin | 
  217.     currentCursor _ Sensor currentCursor.
  218.     currentPoint _ Sensor mousePoint.    "the origin of the cursor is here"
  219.     rect _ Rectangle fromUser.
  220.     area _ Form fromDisplay: rect.
  221.     BinaryChoice
  222.         message: 'OR in cursor?'
  223.         displayAt: Sensor cursorPoint
  224.         centered: true
  225.         ifTrue: [area 
  226.                     copyBits: currentCursor boundingBox
  227.                     from: currentCursor
  228.                     at: currentPoint - rect origin
  229.                     clippingBox: area boundingBox
  230.                     rule: Form paint
  231.                     mask: Form black]
  232.         ifFalse: [].
  233.  
  234.     filename _ FillInTheBlank request: 'Enter filename for bitmap'
  235.                 initialAnswer: 'filename.ps'.
  236.     filename isEmpty ifTrue: [^self].
  237.  
  238.     Display reversePageSizedAreaAt: 10@10.
  239.     position _ (Rectangle fromUserAspectRatio: area extent) translateBy: (10@10) negated.
  240.     Display reversePageSizedAreaAt: 10@10.
  241.     scale _ (position extent / area extent) * Form postScriptPixelsPerInch / DisplayScreen pixelsPerInch.
  242.     origin _ (position origin + (0@position height)) convertFromScreenToPostScriptPixels.
  243.  
  244.     [Transcript show: 'dumping to file ', filename, '...'.
  245.     area psWriteFileOn: filename
  246.           scaleFactor: scale
  247.           origin: origin.
  248.     Transcript show: 'done' ; cr] forkAt: Processor userSchedulingPriority!
  249.  
  250. postScriptPageSize
  251.     "The size of a PostScript page in PostScript default units"
  252.     ^612@792!
  253.  
  254. postScriptPixelsPerInch
  255.     "The default size for PostScript units"
  256.     ^72! !
  257.  
  258. !InputState methodsFor: 'private'!
  259.  
  260.  
  261.  
  262. doScreenDump
  263.     | activeProcess |
  264.     activeProcess _ ScheduledControllers activeControllerProcess.
  265.     (Processor includes: activeProcess) ifTrue: [activeProcess suspend].
  266.     Form doScreenDump.
  267.     (Processor includes: activeProcess) ifFalse: [ScheduledControllers activeControllerProcess resume]!
  268.  
  269.  !
  270.  
  271.  
  272. !ProcessorScheduler methodsFor: 'accessing'!
  273.  
  274. includes: aProcess
  275.     "Is aProcess ready to run?"
  276.  
  277.     ^(quiescentProcessLists at: aProcess priority) includes: aProcess! !
  278.